home *** CD-ROM | disk | FTP | other *** search
/ Loadstar 168 / 168.d81 / uv damage (.txt) < prev    next >
Commodore BASIC  |  2022-08-26  |  4KB  |  139 lines
  1. 5 poke55,.:poke56,56:clr
  2. 10 dv=peek(186):ifdv<8thendv=8
  3. 15 print"[147]":poke53280,.:poke53281,.
  4. 16 poke53371,.
  5. 17 poke53272,31
  6. 18 ad=49152
  7. 20 sysad:sysad+12
  8. 30 gosub930:rem initialize data arrays
  9. 40 print"[147]":sysad+9,8
  10. 45 printtab(3)"[150] [207][218][207][206][197]-[196][197][208][204][197][212][197][196] [213][214] [196][193][205][193][199][197] [201][206][196][197][216] "
  11. 50 print:print"[159] [204]atitude in degrees: ";:l9%=6:gosub1250:l=q9:la=l/57.296
  12. 60 print"[159] [205]onth (1-12): ";:l9%=2:gosub1250:m=q9
  13. 65 ifm=<0orm>12thenprint"[145][145]":goto60
  14. 70 print"[159] [200]ours from local noon: ";:l9%=2:gosub1250:t=q9:t=abs(t)
  15. 80 ds=.408*sin(.523*(m-3.7)):rem decl of sun (radians)
  16. 90 ha=.262*t:rem hour angle of the sun (radians)
  17. 100 cz=sin(la)*sin(ds)+cos(la)*cos(ds)*cos(ha)
  18. 110 ifcz<=0thenprint"[145][145]":goto70
  19. 120 zs=atn(sqr(1-cz*cz)/cz):rem sun's zenith dist. (rad)
  20. 180 print"[159] [200]eight above sea level [158](ft): ";:l9%=6:gosub1250:hh=q9:h=hh/3280
  21. 190 print"[159] [193]erosol extinction [158](.1-.5): ";:l9%=3:gosub1250:kk=q9
  22. 200 be=kk/2.36
  23. 210 print"[159] [211]urface albedo (%): ";:l9%=2:gosub1250:s1=q9:sa=s1/100
  24. 230 rem other adjustable parameters
  25. 250 et=3600:rem exposure time sec
  26. 260 zp=zs:rem angle (rad), zenith to surface normal
  27. 270 ss=0:rem angle (rad), sun to surface normal
  28. 272 print"[159] [193]re you wearing sunblock[158]? [217]/[206]":poke198,.
  29. 274 gethc$:ifhc$<>"y"andhc$<>"n"then274
  30. 275 ifhc$="n"thentw=1:goto290
  31. 276 sysad+9,6
  32. 277 print"[159] [215]hat strength of sunblock?: ";:l9%=2:gosub1250:sb=q9
  33. 279 tw=1/sb
  34. 280 rem tw=1 uv frac. transmitted by window, lotion
  35. 290 f1=1:sysad+9,6:rem fraction of sky that is clear
  36. 300 f2=1:rem fraction of ground in sunlight
  37. 301 print"[159] [193]re you in the shade?:[158] [217]/[206]":poke198,.
  38. 302 gethc$:ifhc$<>"y"andhc$<>"n"then302
  39. 303 ifhc$="y"thensh=0
  40. 304 ifhc$="n"thensh=1
  41. 305 sysad+9,6
  42. 308 printtab(5)"[215]hich [211]kin [212]one are you?"
  43. 309 print"[158]1.[155][215]hite [158]2.[155][207]riental[150]-[155][207]live [195]omplexion"
  44. 310 print"[158]3.[155][204]t [194]rown[150]-[155][204]t [212]anned [158]4.[155][205]edium [194]rown"
  45. 311 print"[158]5.[155][214]ery [212]anned [158]6.[155][204]ight [194]lack [158]7.[155][194]lack"
  46. 312 gethc$:ifhc$<"1"orhc$>"7"then312
  47. 313 sysad+9,6
  48. 314 ifhc$="1"thenn=1
  49. 315 ifhc$="2"thenn=.9
  50. 316 ifhc$="3"thenn=.8
  51. 317 ifhc$="4"thenn=.7
  52. 318 ifhc$="5"thenn=.5
  53. 319 ifhc$="6"thenn=.3
  54. 320 ifhc$="7"thenn=.1
  55. 330 re=6378.14:rem earth radius (km)
  56. 340 ol=15:rem ozone loss (%)
  57. 350 ho=23:rem height of ozone layer
  58. 360 hg=8.2:rem gas scale height (km)
  59. 370 ha=1.5:rem aerosol scale height (km)
  60. 380 ds=1:rem distance from the sun (au)
  61. 400 rem thickness of ozone layer
  62. 420 ra=30*(m-3.7)/57.296
  63. 430 do=(1-ol/100)*(3+.4*(la*cos(ra)-cos(3*la)))
  64. 450 rem airmass for each component
  65. 470 xo=(1-(sin(zs)/(1+((ho-h)/re)))^2)^-.5
  66. 480 xg=1/(cos(zs)+.01*sqr(hg)*exp(-30*cos(zs)/sqr(hg)))
  67. 490 xa=1/(cos(zs)+.01*sqr(ha)*exp(-30*cos(zs)/sqr(ha)))
  68. 510 rem do for each wavelength
  69. 530 poke214,15:print:print"    [195] [207] [205] [208] [213] [212] [201] [206] [199]..."
  70. 550 ed=0
  71. 560 forj=1to20
  72. 570 w=.275+j*.005:rem wavelength (microns)
  73. 590 rem brightness of sunlight, diffuse sky light
  74. 600 sysad+9,5:rem and ground light
  75. 610 ko=oz(j)*(do/3)
  76. 620 kg=.0107*exp(-h/hg)*(w^-4)
  77. 630 ka=be*(w^-1.3)
  78. 640 ot=10^(-.4*(ko*ox))
  79. 650 ta=10^(-.4*(kg*xg+ka*xa))
  80. 660 d=.5*(cos(zs)^.33)
  81. 670 is=fs(j)*ot*ta*tw*sh*cos(ss)*(ds^-2)
  82. 680 id=fs(j)*ot*(1-ta)*d
  83. 690 id=fs(j)*ot*(1-ta)*d*ta*sa+id
  84. 700 id=fs(j)*ot((1-ta)^2)*sa*(d^2)+id
  85. 710 id=id*tw*f1*(cos(zs/2)^2)*(ds^-2)
  86. 720 ig=fs(j)*ot*sa*(ta+d*(1-ta))
  87. 730 ig=ig*tw*f2*(sin(zs/2)^2)*(ds^-2)
  88. 740 i=is+id+ig:rem total flux on skin (erg/cm^2/sec/anstr)
  89. 760 rem find effective dose by numerical integration
  90. 770 rem the minimum erythema dose at 2900 anstr
  91. 780 rem is 2.3e6 erg/cm^2 (parrish)
  92. 800 ef=i*et*(as(j)*n)*50/2.3e6
  93. 810 ed=ed+ef
  94. 830 next j
  95. 850 rem report result
  96. 870 poke214,15:print:print"[156][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162][162]":sysad+9,11
  97. 880 print"[153] [212]otal effective dose:";ed
  98. 890 print"[153] ([197]xposure time hr.) ";et/3600
  99. 895 print"[153] [194]urning starts in mins.";et/(3600*ed)*60
  100. 899 gosub40000
  101. 910 goto40
  102. 930 rem dim and read data
  103. 950 dimoz(20),fs(20),as(20)
  104. 960 forj=1to20:readoz(j):next
  105. 970 forj=1to20:readfs(j):next
  106. 980 forj=1to20:readas(j):next
  107. 990 return
  108. 1010 rem oz array (ozone effect)
  109. 1020 data 34,25,18,9,3.2,1.8,.9,.46,.24,.17
  110. 1030 data .06,.05,.02,.01,.002,.001,0,0,0,0
  111. 1050 rem fs array (solar flux at 1 au in erg/cm^2/sec/anstr
  112. 1060 data24,31,38,45,52,58,64,70,75,79
  113. 1070 data83,87,91,93,95,97,99,104,107,104
  114. 1090 rem as array (action spectrum, mckinley & diffey)
  115. 1100 data 1,1,1,1,.65,.22,.074,.025,.0086,.003
  116. 1110 data .0014,.0012,.00097,.00081,.00068,.00057
  117. 1120 data .00048,.0004,.00034,.00029
  118. 1250 q9$="":poke198,.
  119. 1255 geta$
  120. 1260 poke646,rnd(1)*15+1:print"*[157]";:ifa$=""then1255
  121. 1265 ifa$=chr$(13)thenprint" ":q9=val(q9$):return
  122. 1270 if(a$=chr$(20)andlen(q9$))thenq9$=left$(q9$,len(q9$)-1):goto1300
  123. 1275 iflen(q9$)>=l9%thensysad+9,2:goto1255
  124. 1280 if(a$>="0"anda$<="9")ora$="."ora$="-"then1290
  125. 1285 goto1255
  126. 1290 q9$=q9$+a$
  127. 1295 print""a$;:sysad+9,6:goto1255
  128. 1300 print" [157][157] [157]";:goto1255
  129. 10000 d=peek(186):n$="uv damage":open15,d,15,"s0:"+n$:close15:saven$,d:end
  130. 40000 poke214,21:print:printtab(8)"[159](1[159]) [212]ry another one
  131. 40010 [153][163]8)"open(2open) (NULL)o (NULL)(NULL)right$(NULL)val(NULL)(NULL)val (NULL)enu
  132. 40020 sysad+9,2:poke198,0
  133. 40030 geta$:ifa$<"1"ora$>"2"then40030
  134. 40040 ifa$="1"thenreturn
  135. 40050 sysad+15
  136. 40060 print"[147][144]load"chr$(34)"b.universe ii"chr$(34)","dv
  137. 40070 print"run28"
  138. 40080 poke631,13:poke632,13:poke198,2:end
  139.